set colo to bg+/b,w+/n
SELE 1
GO BOTT
REC=RECNO()
GO TOP
OKK='F'
CNT=0
SELE 1
SET EXCLU OFF
USE &DR1&F1 INDE &DR1&F11
if fname<>space(16)
   SEEK fNAME
   do while PAT_F_NAME=FNAME .AND. .not. eof()
      cnt=cnt+1
      skip
   enddo
   declare norec[cnt]
   declare fild[cnt]
   declare kdpa[cnt]
   go top
   CR=0
   IF CNT<>0
      SELE 1
      USE &DR1&F1 INDE &DR1&F11
      SEEK FNAME
      do while PAT_F_NAME=FNAME .AND. .not. eof()
         cr=cr+1
         norec[cr]=recno()
         fild[cr]=pat_name+' '+pat_f_name+'  '+pat_m_init+;
         '   '+pat_sex+'   '+dtoc(pat_dob)+SPACE(5)+chr(186)+SPACE(4)+pat_filcod
         kdpa[cr]=pat_filcod
         skip
      enddo
      DO WHILE .T.
         @ 7,1 CLEA TO 23,78
         SET COLO TO BG+/B,W+/N
         DO ADDRPAT2
         inkey()
         cari=achoice(9,4,20,75,fild)
         mix=lastkey()
         DO CASE
            CASE MIX=13
               OKK='T'
               DISP='Y'
               REC=norec[cari]
               kdpat=kdpa[cari]
               SELE 1
               SET INDEX TO
               goto REC
               kdpat=PAT_FILCOD
               @ 7,1 CLEA TO 23,78
               RETURN
            CASE MIX=27
               EXIT
            OTHER
               LOOP
         ENDCASE
      ENDDO
   ENDIF
endif
@ 7,1 CLEA TO 23,78
SET COLOR TO R+*/N
@ 12, 25  SAY "Processing, Please wait ..."
SET COLOR TO BG+/B, W+/N
CNT=0
CR=0
SELE 1
SET EXCLU OFF
USE &DR1&F1 INDE &DR1&F11
GO TOP
if fname<>space(16)
   SEEK FNAME
   do while PAT_NAME=FNAME .AND. .not. eof()
      cnt=cnt+1
      skip
   enddo
   declare norec[Cnt]
   declare fild[Cnt]
   declare kdpa[cnt]
   IF CNT<>0
      SELE 1
      USE &DR1&F1 INDE &DR1&F11
      SEEK FNAME
      do while PAT_NAME=FNAME .AND. .not. eof()
         cr=cr+1
         norec[cr]=recno()
         fild[cr]=pat_name+' '+pat_f_name+'  '+pat_m_init+;
         '   '+pat_sex+'   '+dtoc(pat_dob)+SPACE(5)+chr(186)+SPACE(4)+pat_filcod
         kdpa[cr]=pat_filcod
         skip
      enddo
      DO WHILE .T.
         @ 7,1 CLEA TO 23,78
         DO ADDRPAT2
         SET COLO TO BG+/B,W+/N
         inkey()
         cari=achoice(9,4,20,75,fild)
         mx=lastkey()
         DO CASE
            CASE MX=13
               OKK='T'
               DISP='Y'
               REC=norec[cari]
               kdpat=kdpa[cari]
               SELE 1
               SET INDEX TO
               goto REC
               kdpat=PAT_FILCOD
               @ 7,1 CLEA TO 23,78
               RETURN
            CASE MX=27
               EXIT
            OTHER
               LOOP
         ENDCASE
      ENDDO
   ENDIF
   @ 7,1 CLEA TO 23,78
   SET COLOR TO R+*/N
   @ 12, 25  SAY "Processing, Please wait ..."
   SET COLOR TO BG+/B, W+/N
   CNT=0
   CR=0
   SELE 1
   SET EXCLU OFF
   USE &DR1&F1 INDE &DR1&F12
   SEEK FNAME
   do while PAT_F_NAME=FNAME .AND. .not. eof()
      CNT=CNT+1
      skip
   enddo
   declare norec[cnt]
   declare fild[cnt]
   declare kdpa[cnt]
   IF CNT<>0
      SELE 1
      USE &DR1&F1 INDE &DR1&F12
      SEEK FNAME
      do while PAT_F_NAME=FNAME .AND. .not. eof()
         CR=CR+1
         norec[CR]=recno()
         fild[CR]=pat_f_name+' '+pat_name+'  '+pat_m_init+;
         '   '+pat_sex+'   '+dtoc(pat_dob)+SPACE(5)+chr(186)+SPACE(4)+pat_filcod
         kdpa[cr]=pat_filcod
         skip
      enddo
      DO WHILE .T.
         @ 7,1 CLEA TO 23,78
         SET COLO TO BG+/B,W+/N
         DO ADDRPAT3
         inkey()
         cari=achoice(9,4,20,75,fild)
         mx=lastkey()
         DO CASE
            CASE MX=13
               OKK='T'
               DISP='Y'
               REC=norec[cari]
               kdpat=kdpa[cari]
               SELE 1
               SET INDEX TO
               goto REC
               kdpat=PAT_FILCOD
               @ 7,1 CLEA TO 23,78
               RETURN
            CASE MX=27
               EXIT
            OTHER
               LOOP
         ENDCASE
      ENDDO
   ENDIF
endif
@ 7,1 CLEA TO 23,78
SET COLOR TO R+*/N
@ 12, 25  SAY "Processing, Please wait ..."
SET COLOR TO BG+/B, W+/N
CNT=0
CR=0
SELE 1
SET EXCLU OFF
USE &DR1&F1 INDE &DR1&F12
if sname<>space(16)
   SEEK SUBS(SNAME,1,3)
   do while SUBS(PAT_F_NAME,1,3)=SUBS(SNAME,1,3) .AND. .not. eof()
      cnt=cnt+1
      skip
   enddo
   declare norec[Cnt]
   declare fild[Cnt]
   declare kdpa[cnt]
   IF CNT<>0
      SELE 1
      USE &DR1&F1 INDE &DR1&F12
      SEEK SUBS(SNAME,1,3)
      do while SUBS(PAT_F_NAME,1,3)=SUBS(SNAME,1,3) .AND. .not. eof()
         CR=CR+1
         norec[CR]=recno()
         fild[CR]=pat_f_name+' '+pat_name+'  '+pat_m_init+;
         '   '+pat_sex+'   '+dtoc(pat_dob)+SPACE(5)+chr(186)+SPACE(4)+pat_filcod
         kdpa[cr]=pat_filcod
         skip
      enddo
      DO WHILE .T.
         @ 7,1 CLEA TO 23,78
         SET COLO TO BG+/B,W+/N
         DO ADDRPAT3
         inkey()
         cari=achoice(9,4,20,75,fild)
         mx=lastkey()
         DO CASE
            CASE MX=13
               OKK='T'
               DISP='Y'
               REC=norec[cari]
               kdpat=kdpa[cari]
               SELE 1
               SET INDEX TO
               goto REC
               kdpat=PAT_FILCOD
               @ 7,1 CLEA TO 23,78
               RETURN
            CASE MX=27
               OKK='F'
               DISP='T'
               EXIT
            OTHER
               LOOP
         ENDCASE
      ENDDO
   ENDIF
endif
@ 7,1 CLEA TO 23,78
RETURN
